import Control.Monad.State
import System.Console.Readline
import Text.Regex.Posix
import Control.Monad.Error

import Buffer
import Data
import Parser
import Engine

type EEditor w	= ErrorT Err (Editor w) 

putfile x 	= get >>= \y -> put y {file = x}

lprint 		:: String -> EEditor w ()
lprint x 	= liftIO . putStrLn $ x

linput 		:: String -> EEditor w (Maybe String)
linput x 	= liftIO (readline x)

lerror r 	= lprint ("? " ++ r)

inHistory	:: String -> EEditor w ()
inHistory x 	= liftIO . addHistory $ x

lprompt	:: Engine w 	=> EEditor w (Maybe String)
lprompt	= do 
	p <- gets $ pos . file
	linput $ case p of 
		Begin -> "0 > "
		Line p -> show p ++ " > "
		End _ -> "$ > "

run	:: Engine w 	=> EEditor w a -> Stato w -> IO (Stato w)
run f = execStateT $ ignoreError f where
	ignoreError x 	= either (const ()) (const ()) `fmap` runErrorT x

data Err 
	= StopErr 
	| ParserErr String 
	| EvalErr String 
	| BackendErr 
	| Ahi String 
	deriving Show

instance Error Err where
	noMsg 	= Ahi "nomsg"
	strMsg 	= Ahi

commandMode 	:: Engine w 	=> EEditor w ()
commandMode 	= let 
	parse line 	= either (throwError . ParserErr . show) 
				((inHistory line >>). eval) 
				(command line)
	in 	lprompt >>= maybe (throwError StopErr) parse

commandLoop :: Engine w 	=> EEditor w ()
commandLoop 	= let 	
	reaction StopErr 	= lprint "End" >> return False
	reaction (Ahi x) 	= lprint  ("Unhandled exception: " ++ x) >> return False
	reaction BackendErr 	= lprint "Buffer index error" >> return True
	reaction (ParserErr s) 	= lprint ("Parser error: " ++ s) >> return True
	reaction (EvalErr s) 	= lprint ("Evaluation error: " ++ s) >> return True
	in do run <- catchError (commandMode >> return True) reaction 
	      if run then commandLoop else return ()

inputMode	::  EEditor w [String] 
inputMode	= linput "" >>= maybe (return []) aline
	where aline jl = inHistory jl >> inputMode >>= return . (jl:)

backend	:: Engine w 	=> Maybe a -> EEditor w a
backend	= maybe (throwError BackendErr) return


through f = gets file >>= backend . f

jumpE 		:: Engine w 	=> Offset -> EEditor w ( w)
jumpE o 	= through $ how o 
  where
	how Current 		= Just
	how LastLine 		= end 
	how (Next n) 		= nextn n 
	how (Prev n) 		= prevn n 
	how (Absolute n) 	= jump n
	--how (ReNext s) w = 

-- | From a range to the tuple (nelements,starting range element)
rangeResolve 	:: Engine w => Range -> EEditor w (Int,  w)
rangeResolve (Range o1 o2) 	= do 
	w1 <- jumpE o1 
	w2 <- jumpE o2 
	return (distance (pos w2) (pos w1) , w1)

doOffset	:: Engine w	
		=> Offset -> (a -> EEditor w ()) -> ( w -> Maybe a) -> EEditor w ()
doOffset o ef mf 	= jumpE o >>= backend . mf >>= ef
editOffset o 		= doOffset o putfile 

doRange r ef mf 	= rangeResolve r >>= backend . uncurry mf >>= ef
editRange r 		= doRange r putfile

eval :: (Engine w) => CompleteCommand -> EEditor w ()
eval (CC Append (ORO o)) 	= inputMode >>= editOffset o . add
eval (CC Insert (ORO o)) 	= inputMode >>= editOffset o . ins
eval (CC Delete (ORO o)) 	= editOffset o del
eval (CC Delete (ORR r)) 	= editRange r deln
eval (CC Change (ORO o)) 	= do
	w <- jumpE o 
	(l,u) <- backend  $  line w >>= \l -> del w >>= \u -> return (l,u)
	inHistory l >> inputMode >>= backend . flip ins u >>= putfile

eval (CC Change (ORR r)) = do
	(n,w) <- rangeResolve r 
	u <- backend  $  deln n w 
	inputMode >>=  backend . flip ins u >>= putfile

eval (CC Print (ORO o)) 	= doOffset o lprint line
eval (CC Print (ORR r)) 	= doRange r (mapM_ lprint) values
eval (CC NoCommand (ORO o)) 	= jumpE o >>= \w -> backend (line w) >>= lprint >> putfile w
eval (CC NoCommand ORN) 	= 
	jumpE (Next 1) >>= \w -> backend (line w) >>= lprint >> putfile w




test 	= Stato (listIn ["Paolo","va","in","letargo","in","inverno."])  "" 
	:: Stato InsideAppend
main 	= run commandLoop test
